home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / mutt / picture.mut < prev    next >
Lisp/Scheme  |  1988-09-07  |  24KB  |  720 lines

  1. ;; "Picture mode" -- editing using quarter-plane screen model.
  2. ;; Copyright (C) 1985 Free Software Foundation, Inc.
  3. ;; Principal author K. Shane Hartman
  4. ;; Converted to Mutt 6/88 C Durland
  5.  
  6. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  7. ;;;;;;;;;;;;;;;;;;;; Utilities ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  9.  
  10.   ;; Eliminate whitespace at ends of lines.
  11. (defun remove-trailing-whitespace
  12. {
  13.   (arg-prefix 9)(set-mark)
  14.   (beginning-of-buffer)
  15.   (re-query-replace '\ +$' "")
  16.   (arg-prefix 9)(exchange-dot-and-mark)
  17.   (msg "Removed trailing whitespace")
  18. })
  19.  
  20.     ; move to the next tab stop in the tabs list
  21. (defun tab-to-tab-stop (int num-tabs) (array byte tabs 1)
  22. {
  23.   (int i col)
  24.  
  25.   (col (current-column))
  26.   (for (i 0) (and (< i num-tabs)(>= col (tabs i))) (+= i 1) ())
  27.   (if (< i num-tabs) { (to-col (i (tabs i))) i } col)
  28. })
  29.  
  30. (include asc.mut)
  31.  
  32. (include me.h)
  33.  
  34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35. ;;;;;;;;;;;;;;;; Picture Movement Commands ;;;;;;;;;;;;;;;;;;;;;;;;;
  36. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37.  
  38.   ;; Move to column in current line.
  39.   ;; Differs from move-to-column in that it creates or modifies whitespace
  40.   ;;   if necessary to attain exactly the specified column.
  41. (defun move-to-column-force (int column) HIDDEN
  42. {
  43.   (current-column column) (to-col column)
  44. })
  45.  
  46.   ;; Move forward n lines, creating new ones if needed
  47. (defun pforward-line (int n) HIDDEN
  48. {
  49.   (int oo)
  50.   (oo (overstrike))(overstrike 1)
  51.   (arg-prefix n)(newline)
  52.   (overstrike oo)
  53. })
  54.  
  55.   ;; Position point after last non-blank character on current line.
  56.   ;; With ARG not nil, move forward ARG - 1 lines first.
  57.   ;; If scan reaches end of buffer, stop there without error.
  58. (defun picture-end-of-line
  59. {
  60.   (if (arg-flag) (forward-line (- (arg-prefix) 1)))
  61.   (end-of-line)
  62.   (if (previous-character)
  63.   {
  64.     (while (isspace) (previous-character))
  65.     (next-character)
  66.   })
  67. })
  68.  
  69.   ;; Move cursor right, making whitespace if necessary.
  70.   ;; With argument, move that many columns.
  71. (defun picture-forward-column
  72. {
  73.   (move-to-column-force (+ (current-column) (arg-prefix)))
  74. })
  75.  
  76.   ;; Move cursor left, making whitespace if necessary.
  77.   ;; With argument, move that many columns.
  78. (defun picture-backward-column
  79. {
  80.   (move-to-column-force (- (current-column) (arg-prefix)))
  81. })
  82.  
  83.   ;; Move vertically down, making whitespace if necessary.
  84.   ;; With argument, move that many lines.
  85. (defun picture-move-down
  86. {
  87.   (int col)
  88.  
  89.   (col (current-column))
  90.   (pforward-line (arg-prefix))
  91.   (move-to-column-force col)
  92. })
  93.  
  94.   ;; Move vertically up, making whitespace if necessary.
  95.   ;; With argument, move that many lines.
  96. (defun picture-move-up
  97. {
  98.   (int col n)
  99.  
  100.   (n (arg-prefix))
  101.   (col (current-column))
  102.  
  103.   (while (>= (-= n 1) 0)
  104.     (if (not (forward-line -1))    ; at top of buffer
  105.     { (beginning-of-buffer)(open-line) })
  106.   )
  107.   (move-to-column-force col)
  108. })
  109.  
  110.   ;; Amount to move vertically after text character in Picture mode.
  111. (int picture-vertical-step)
  112.  
  113.   ;; Amount to move horizontally after text character in Picture mode.
  114. (int picture-horizontal-step)
  115.  
  116.   ;; Set VERTICAL and HORIZONTAL increments for movement in Picture mode.
  117.   ;; The mode line is updated to reflect the current direction.
  118. (defun picture-set-motion (int vert horiz) HIDDEN
  119. {
  120.   (picture-vertical-step vert)
  121.   (picture-horizontal-step horiz)
  122. ;  (setq mode-name
  123. ;    (format "Picture:%s"
  124. ;        (car (nthcdr (+ 1 (% horiz 2) (* 3 (1+ (% vert 2))))
  125. ;                 '(nw up ne left none right sw down se)))))
  126.   (msg "Picture: "
  127.     (switch (+ 1 horiz (* 3 (+ 1 vert)))
  128.       0 "NW"
  129.       1 "up"
  130.       2 "NE"
  131.       3 "left"
  132.       4 "none"
  133.       5 "right"
  134.       6 "SW"
  135.       7 "down"
  136.       8 "SE"
  137.     )
  138.   )
  139. })
  140.  
  141.   ;; Move right after self-inserting character in Picture mode.
  142. (defun picture-movement-right { (picture-set-motion 0 1) })
  143.  
  144.   ;; Move left after self-inserting character in Picture mode.
  145. (defun picture-movement-left { (picture-set-motion 0 -1) })
  146.  
  147.   ;; Move up after self-inserting character in Picture mode.
  148. (defun picture-movement-up { (picture-set-motion -1 0) })
  149.  
  150.   ;; Move down after self-inserting character in Picture mode.
  151. (defun picture-movement-down { (picture-set-motion 1 0) })
  152.  
  153.   ;; Move up and left after self-inserting character in Picture mode.
  154. (defun picture-movement-nw { (picture-set-motion -1 -1) })
  155.  
  156.   ;; Move up and right after self-inserting character in Picture mode.
  157. (defun picture-movement-ne { (picture-set-motion -1 1) })
  158.  
  159.   ;; Move down and left after self-inserting character in Picture mode.
  160. (defun picture-movement-sw { (picture-set-motion 1 -1) })
  161.  
  162.   ;; Move down and right after self-inserting character in Picture mode.
  163. (defun picture-movement-se { (picture-set-motion 1 1) })
  164.  
  165.   ;; Move in direction of picture-vertical-step and picture-horizontal-step.
  166.   ;; With ARG do it that many times.
  167.   ;; Useful for delineating rectangles in conjunction with diagonal
  168.   ;;   picture motion.
  169.   ;; Do apropos picture-movement  to see commands which control motion.
  170. (defun picture-move
  171. {
  172.   (int col)
  173.  
  174.   (col (+ (current-column) (* picture-horizontal-step (arg-prefix))))
  175.   (case
  176.     (< picture-vertical-step 0) (picture-move-up)
  177.     (> picture-vertical-step 0) (picture-move-down)
  178.   )
  179.   (move-to-column-force col)
  180. })
  181.  
  182.   ;; Move point in direction opposite of current picture motion in Picture mode.
  183.   ;; With ARG do it that many times.
  184.   ;; Useful for delineating rectangles in conjunction with diagonal
  185.   ;;   picture motion.
  186.   ;; Do apropos picture-movement  to see commands which control motion.
  187. (defun picture-move-reverse
  188. {
  189.   (*= picture-vertical-step -1)(*= picture-horizontal-step -1)
  190.   (picture-move)
  191.   (*= picture-vertical-step -1)(*= picture-horizontal-step -1)
  192. })
  193.  
  194. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  195. ;;;;;;;;;; Picture insertion and deletion ;;;;;;;;;;;;;;;;;;;;;;;;;;
  196. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  197.  
  198.   ;; Insert character in place of character previously at the cursor.
  199.   ;; The cursor then moves in the direction previously specified
  200.   ;;   with the picture-movement- commands.
  201.   ;; Do apropos  picture-movement  to see those commands.
  202. (defun picture-insert (string c)(int n) HIDDEN
  203. {
  204.   (int i)
  205.  
  206.   (i n)
  207.   (while (> i 0)
  208.   {
  209.     (-= i 1)
  210.     (move-to-column-force (+ 1 (current-column)))    ; break up any tabs
  211.     (delete-previous-character)
  212.     (insert-text c)
  213.     (previous-character)
  214.     (arg-prefix 1)(picture-move)
  215.   })
  216. })
  217.  
  218. (defun picture-self-insert
  219. {
  220.   (string key 10)
  221.  
  222.   (picture-insert (asc (key-pressed) key) (arg-prefix))
  223. })
  224.  
  225.   ;; Clear out ARG columns after point without moving.
  226. (defun picture-clear-column
  227. {
  228.   (int col)
  229.  
  230.   (set-mark)(msg "")
  231.   (col (current-column (+ (current-column) (arg-prefix))))
  232.   (erase-region)(to-col col)
  233.   (exchange-dot-and-mark)
  234. })
  235.  
  236.   ;; Clear out ARG columns before point, moving back over them.
  237. (defun picture-backward-clear-column
  238. {
  239.   (if (== 1 (current-column)) (done))    ; no op if at begining of line
  240.   (move-to-column-force (- (current-column) (arg-prefix)))
  241.   (picture-clear-column)
  242. })
  243.  
  244.   ;; Clear out rest of line; if at end of line, advance to next line.
  245.   ;; Cleared-out line text goes into the kill ring, as do
  246.   ;;   newlines that are advanced over.
  247.   ;; With argument, clear out (and save in kill ring) that many lines.
  248. (defun picture-clear-line
  249. {
  250.   (int n)
  251.  
  252.   (if (arg-flag)
  253.     {
  254.       (arg-prefix (n (arg-prefix))) (kill-line)
  255.       (arg-prefix n)(newline)
  256.     }
  257.     {
  258.       (if (looking-at '.+$')(kill-line))
  259.       (append-to-register 0 "^J")    ; tack a newline to end of killbuffer
  260.       (forward-line 1)
  261.     }
  262.   )
  263. })
  264.  
  265.   ;; Move to the beginning of the following line.
  266.   ;; With argument, moves that many lines (up, if negative argument).
  267.   ;; Always moves to the beginning of a line.
  268. (defun picture-newline
  269. {
  270.   (int n)
  271.  
  272.   (if (< (n (arg-prefix)) 0)    ; negative arg => move up
  273.     (forward-line n)
  274.     (pforward-line n)
  275.   )
  276. })
  277.  
  278.   ;; Insert an empty line after the current line.
  279.   ;; With positive argument insert that many lines.
  280. (defun picture-open-line
  281. {
  282.   (int n)
  283.  
  284.   (n (arg-prefix))
  285.   (arg-prefix 9)(set-mark)
  286.   (end-of-line)(arg-prefix n)(open-line)
  287.   (arg-prefix 9)(exchange-dot-and-mark)
  288.   (msg "")
  289. })
  290.  
  291.   ;; Insert a duplicate of the current line, below it.
  292. (defun picture-duplicate-line
  293. {
  294.   (int col)
  295.  
  296.   (col (current-column))
  297.   (beginning-of-line)(clear-register 0)
  298.   (arg-prefix 1)(kill-line)
  299.   (yank)(yank)
  300.   (forward-line -2)(current-column col)
  301. })
  302.  
  303. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  304. ;;;;;;;;;;;;;;;;;; Picture Tabs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  305. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  306.  
  307.   ;; A character set which controls behavior of commands
  308.   ;;  (picture-set-tab-stops) and (picture-tab-search).  It is NOT a
  309.   ;;  regular expression, any regexp special characters will be quoted.
  310.   ;; It defines a set of "interesting characters" to look for when setting
  311.   ;; (or searching for) tab stops, initially "!-~" (all printing characters).
  312.   ;; For example, suppose that you are editing a table which is formatted thus:
  313.   ;;    | foo        | bar + baz | 23  *
  314.   ;;    | bubbles    | and + etc | 97  *
  315.   ;;   and that picture-tab-chars is "|+*".  Then invoking
  316.   ;;   [picture-set-tab-stops] on either of the previous lines would result
  317.   ;;   in the following tab stops:
  318.   ;;            :     :     :     :
  319.   ;; Another example - "A-Za-z0-9" would produce the tab stops
  320.   ;;      :          :    :     :
  321.  
  322.   ;; Note that if you want the character `-' to be in the set, it must be
  323.   ;;   included in a range or else appear in a context where it cannot be
  324.   ;;   taken for indicating a range (e.g. "-A-Z" declares the set to be the
  325.   ;;   letters `A' through `Z' and the character `-').  If you want the
  326.   ;;   character `\' in the set it must be preceded by itself: "\\".
  327.  
  328.   ;; The command (picture-tab-search) is defined to move beneath (or to) a
  329.   ;;   character belonging to this set independent of the tab stops list.
  330.  
  331. (const default-pic-tab-chars '-!~|')
  332. (string picture-tab-chars 50)
  333. (array byte pic-tabs 70)
  334. (int num-pic-tabs)
  335.  
  336.   ;; Set value of  tab-stop-list  according to context of this line.
  337.   ;; This controls the behavior of (picture-tab).  A tab stop
  338.   ;;   is set at every column occupied by an "interesting character" that is
  339.   ;;   preceded by whitespace.  Interesting characters are defined by the
  340.   ;;   variable  picture-tab-chars,  see its documentation for an example
  341.   ;;   of usage.
  342.   ;; With ARG, just (re)set  tab-stop-list  to its default value.
  343.   ;; The tab stops computed are displayed in the minibuffer with `:' at
  344.   ;; each stop.
  345. (defun sleeze-ball (array byte str 1) HIDDEN
  346. {
  347.   (int i)
  348.  
  349.   (for (i 0) (< i num-pic-tabs)(+= i 1) (str (- (pic-tabs i) 1) 0x3A)) ; ":"
  350.   str
  351. })
  352. (defun picture-set-tab-stops
  353. {
  354.   (int i)
  355.   (string regexp 90)
  356.  
  357. ;(if arg (setq tabs (default-value 'tab-stop-list))
  358.  
  359.   (set-mark)
  360.   (regexp (concat '\ +[' picture-tab-chars "]"))
  361.   (beginning-of-line)
  362.   (for (num-pic-tabs 0)
  363.        (and (re-search-forward regexp)
  364.         (== DOT-ON-SAME-LINE-AS-MARK (compare-dot-and-mark)))
  365.        (+= num-pic-tabs 1)
  366.      (pic-tabs num-pic-tabs (- (current-column) 1))
  367. ;; ??? (skip-chars-forward " \t")
  368.   )
  369.   (exchange-dot-and-mark)
  370.   (if (== 0 num-pic-tabs)
  371.   {
  372.     (msg "No characters in set " picture-tab-chars " on this line.")
  373.     (done)
  374.   })
  375.   (msg (sleeze-ball "                                                                             "))
  376. })
  377.  
  378.   ;; Move to column beneath next interesting char in previous line.
  379.   ;;   The cursor stays in the current line.
  380.   ;; With ARG move to column occupied by next interesting character in this
  381.   ;;   line.  The character must be preceded by whitespace.
  382.   ;; "Interesting characters" are defined by variable  picture-tab-chars.
  383.   ;; If no such character is found, move to beginning of line.
  384. (defun picture-tab-search
  385. {
  386.   (int i)
  387.   (string regexp 90)
  388.  
  389.   (set-mark)(msg "")
  390.   (regexp (concat '\ +[' picture-tab-chars "]"))
  391.   (if (arg-flag)
  392.   {
  393.     (if (and (re-search-forward regexp)
  394.          (== DOT-ON-SAME-LINE-AS-MARK (compare-dot-and-mark)))
  395.     { (previous-character)(done) })
  396.   }
  397.   {
  398.     (i (current-column))
  399.     (while TRUE        ; look for non blank line
  400.     {
  401.       (if (forward-line -1)
  402.       {
  403.     (if (looking-at '^\ *$') (continue)    ; blank line
  404.       (break)                ; non blank line
  405.     )
  406.       })
  407.       (goto done)    ; hit top of buffer
  408.     })
  409.     (current-column i)
  410.     (if (and (re-search-forward regexp)
  411.          (== DOT-ABOVE-MARK (compare-dot-and-mark)))
  412.     {
  413.       (i (current-column))
  414.       (exchange-dot-and-mark)
  415.       (move-to-column-force (- i 1))
  416.       (done)
  417.     })
  418.   })
  419. (label done)
  420.   (exchange-dot-and-mark)(beginning-of-line)
  421. })
  422.  
  423.   ;; Tab transparently (move) to next tab stop.
  424.   ;; With ARG overwrite the traversed text with spaces.
  425.   ;; The tab stop list can be changed by (picture-set-tab-stops) and
  426.   ;;   (edit-tab-stops).
  427.   ;; See also documentation for variable  picture-tab-chars.
  428. (defun picture-tab
  429. {
  430.   (int target)
  431.  
  432.   (set-mark)(msg "")
  433.   (target (tab-to-tab-stop num-pic-tabs pic-tabs))
  434.   (erase-region)
  435.   (move-to-column-force target)
  436.   (if (arg-flag) { (erase-region)(to-col target) })
  437. })
  438.  
  439.  
  440. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  441. ;;;;;;;;;;;;;;;;;; Picture Rectangles ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  442. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  443.  
  444.   ;; Rectangle killed or copied by (picture-clear-rectangle) in Picture mode.
  445.   ;; The contents can be retrieved by (picture-yank-rectangle)
  446. (const picture-killed-rectangle 1)
  447.  
  448.  ;; Clear and save rectangle delineated by point and mark.
  449.  ;; The rectangle is saved for yanking by picture-yank-rectangle and replaced
  450.  ;;   with whitespace.  The previously saved rectangle, if any, is lost.
  451.  ;; With prefix argument, the rectangle is actually killed, shifting remaining
  452.  ;;   text.
  453. (defun picture-clear-rectangle
  454. {
  455.   (copy-rectangle picture-killed-rectangle)(erase-rectangle (arg-flag))
  456. })
  457.  
  458.   ;; Clear rectangle delineated by point and mark into REGISTER.
  459.   ;; The rectangle is saved in REGISTER and replaced with whitespace.
  460.   ;; With prefix argument, the rectangle is actually killed, shifting remaining
  461.   ;; text.
  462. (defun picture-clear-rectangle-to-register
  463. {
  464.   (int n)
  465.  
  466.   (n (atoi (ask "Rectangle to register: ")))
  467.   (copy-rectangle n) (erase-rectangle (arg-flag))
  468. })
  469.  
  470.   ;; Overlay RECTANGLE with upper left corner at point.
  471.   ;; Optional argument INSERTP, if non-nil causes RECTANGLE to be inserted.
  472.   ;; Leaves the region surrounding the rectangle.
  473. (defun picture-insert-rectangle (int rectangle) (bool insert) HIDDEN
  474. {
  475.   (byte type)(int width height)(INT size)
  476.   (int col)
  477.  
  478.   (register-stats rectangle (loc type))
  479.   (if (!= type 1) { (msg "Not a rectangle.") (done) })
  480.   (if (not insert)
  481.   {
  482.     (set-mark)(msg "")(col (current-column))    ; set mark at upper left column
  483.     ; put dot as close as possible to lower right column
  484.     (forward-line (- height 1))(move-to-column-force (+ col width))
  485.     (erase-rectangle TRUE)
  486.   })
  487.   (insert-register rectangle)
  488. })
  489.  
  490.   ;; Overlay rectangle saved by picture-clear-rectangle.
  491.   ;; The rectangle is positioned with upper left corner at point, overwriting
  492.   ;;   existing text.  With prefix argument, the rectangle is inserted instead,
  493.   ;;   shifting existing text.  Leaves mark at one corner of rectangle and
  494.   ;;   point at the other (diagonally opposed) corner.
  495. (defun picture-yank-rectangle
  496. {
  497.   (picture-insert-rectangle picture-killed-rectangle (arg-flag))
  498. })
  499.  
  500.   ;; Overlay rectangle saved in REGISTER.
  501.   ;; The rectangle is positioned with upper left corner at point, overwriting
  502.   ;;   existing text.
  503.   ;; With prefix argument, the rectangle is inserted instead, shifting existing text.
  504.   ;; Leaves mark at one corner of rectangle and point at the other
  505.   ;;  (diagonally opposed) corner.
  506.  
  507. (defun picture-yank-rectangle-from-register
  508. {
  509.   (int n)
  510.  
  511.   (n (atoi (ask "Rectangle from register: ")))
  512.   (picture-insert-rectangle n (arg-flag))
  513. })
  514.  
  515. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  516. ;;;;;;;;;;;;;;;; Misc goodies ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  517. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  518.  
  519. (const
  520.   UPPER-LEFT-CORNER "." UPPER-EDGE "-" UPPER-RIGHT-CORNER "."
  521.   LOWER-LEFT-CORNER "`" LOWER-EDGE "-" LOWER-RIGHT-CORNER "'"
  522.   LEFT-SIDE "|" RIGHT-SIDE "|"
  523. )
  524.  
  525.   ;; Draw a box around the region-rectangle
  526. (defun picture-box
  527. {
  528.   (byte type)(int ulcol width height)(INT size)
  529.  
  530.   (region-stats (loc type))
  531.  
  532.     ;; move dot to upper left corner of box
  533.   (if (== type MARK-ABOVE-DOT) (exchange-dot-and-mark))
  534.   (move-to-column-force ulcol)
  535.  
  536.   (if (or (< (-= width 1) 1)(< (-= height 2) 1))
  537.      { (msg "Box too small")(done) })
  538.     ;; draw top of box
  539.   (picture-movement-right)
  540.   (picture-insert UPPER-LEFT-CORNER 1)(picture-insert UPPER-EDGE width)
  541.     ;; draw right side of box
  542.   (picture-movement-down)
  543.   (picture-insert UPPER-RIGHT-CORNER 1)(picture-insert RIGHT-SIDE height)
  544.     ;; draw bottom of box
  545.   (picture-movement-left)
  546.   (picture-insert LOWER-RIGHT-CORNER 1)(picture-insert LOWER-EDGE width)
  547.     ;; draw left side of box
  548.   (picture-movement-up)
  549.   (picture-insert LOWER-LEFT-CORNER 1)(picture-insert LEFT-SIDE height)
  550.     ;; finished
  551.   (picture-movement-right)
  552. })
  553.  
  554. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  555. ;;;;;;;;;;; Picture Keymap, entry and exit points ;;;;;;;;;;;;;;;;;;
  556. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  557.  
  558. (defun pic-keymap HIDDEN
  559. {
  560.   (int i)
  561.   (string str 10)
  562.  
  563.   (prefix-key 2 "C-C")
  564.  
  565.   (for (i 0x20) (< i 0x7F) (+= i 1)
  566.     (bind-local-key "picture-self-insert" (asc i str)))
  567.  
  568.   (bind-local-key "picture-forward-column"    "C-f")
  569.   (bind-local-key "picture-backward-column"    "C-b")
  570.   (bind-local-key "picture-clear-column"    "C-d")
  571.   (bind-local-key "delete-character"        "C-cC-d")
  572.   (bind-local-key "picture-backward-clear-column" "C-H")
  573.   (bind-local-key "picture-clear-line"        "C-k")
  574.   (bind-local-key "picture-open-line"        "C-o")
  575.   (bind-local-key "picture-newline"        "C-m")
  576.   (bind-local-key "picture-move-down"        "C-n")
  577.   (bind-local-key "picture-move-up"        "C-p")
  578.   (bind-local-key "picture-end-of-line"        "C-e")
  579.   (bind-local-key "picture-duplicate-line"    "C-j")
  580.  
  581.   (bind-local-key "picture-tab"            "C-I")
  582.   (bind-local-key "picture-tab-search"        "M-C-I")
  583.   (bind-local-key "picture-set-tab-stops"    "C-cC-i")
  584.  
  585.   (bind-local-key "picture-mode-exit"        "C-cC-c")
  586.   (bind-local-key "picture-move"        "C-cC-f")
  587.   (bind-local-key "picture-move-reverse"    "C-cC-b")
  588.  
  589.   (bind-local-key "picture-movement-left"    "C-c<")
  590.   (bind-local-key "picture-movement-right"    "C-c>")
  591.   (bind-local-key "picture-movement-up"        'C-c^')
  592.   (bind-local-key "picture-movement-down"    "C-c.")
  593.   (bind-local-key "picture-movement-nw"        "C-c`")
  594.   (bind-local-key "picture-movement-ne"        "C-c'")
  595.   (bind-local-key "picture-movement-sw"        "C-c/")
  596.   (bind-local-key "picture-movement-se"        "C-c\\")
  597.  
  598.   (bind-local-key "picture-clear-rectangle"    "C-cC-k")
  599.   (bind-local-key "picture-clear-rectangle-to-register" "C-cC-w")
  600.   (bind-local-key "picture-yank-rectangle"    "C-cC-y")
  601.   (bind-local-key "picture-yank-rectangle-from-register" "C-cC-x")
  602. })
  603.  
  604. (defun pic-unkeymap HIDDEN
  605. {
  606.   (int i)
  607.   (string str 10)
  608.  
  609.   (prefix-key 2 "S-")
  610.  
  611.   (for (i 0x20) (< i 0x7F) (+= i 1)
  612.     (bind-local-key "" (asc i str)))
  613.  
  614.   (bind-local-key ""    "C-f")
  615.   (bind-local-key ""    "C-b")
  616.   (bind-local-key ""    "C-d")
  617.   (bind-local-key ""    "C-cC-d")
  618.   (bind-local-key ""    "C-H")
  619.   (bind-local-key ""    "C-k")
  620.   (bind-local-key ""    "C-o")
  621.   (bind-local-key ""    "C-m")
  622.   (bind-local-key ""    "C-j")
  623.   (bind-local-key ""    "C-n")
  624.   (bind-local-key ""    "C-p")
  625.   (bind-local-key ""    "C-e")
  626.   (bind-local-key ""    "C-I")
  627.   (bind-local-key ""    "M-C-I")
  628.   (bind-local-key ""    "C-cC-i")
  629.   (bind-local-key ""    "C-cC-c")
  630.   (bind-local-key ""    "C-cC-f")
  631.   (bind-local-key ""    "C-cC-b")
  632.   (bind-local-key ""    "C-c<")
  633.   (bind-local-key ""    "C-c>")
  634.   (bind-local-key ""    'C-c^')
  635.   (bind-local-key ""    "C-c.")
  636.   (bind-local-key ""    "C-c`")
  637.   (bind-local-key ""    "C-c'")
  638.   (bind-local-key ""    "C-c/")
  639.   (bind-local-key ""    "C-c\\")
  640.   (bind-local-key ""    "C-cC-k")
  641.   (bind-local-key ""    "C-cC-w")
  642.   (bind-local-key ""    "C-cC-y")
  643.   (bind-local-key ""    "C-cC-x")
  644. })
  645.  
  646.   ;; Switch to Picture mode, in which a quarter-plane screen model is used.
  647.   ;; Printing characters replace instead of inserting themselves with motion
  648.   ;;   afterwards settable by these commands:
  649.   ;;   C-c <    Move left after insertion.
  650.   ;;   C-c >    Move right after insertion.
  651.   ;;   C-c ^    Move up after insertion.
  652.   ;;   C-c .    Move down after insertion.
  653.   ;;   C-c `    Move northwest (nw) after insertion.
  654.   ;;   C-c '    Move northeast (ne) after insertion.
  655.   ;;   C-c /    Move southwest (sw) after insertion.
  656.   ;;   C-c \    Move southeast (se) after insertion.
  657.   ;; The current direction is displayed in the mode line.  The initial
  658.   ;;   direction is right.  Whitespace is inserted and tabs are changed to
  659.   ;;   spaces when required by movement.  You can move around in the buffer
  660.   ;;   with these commands:
  661.   ;;   C-p    Move vertically to SAME column in previous line.
  662.   ;;   C-n    Move vertically to SAME column in next line.
  663.   ;;   C-e    Move to column following last non-whitespace character.
  664.   ;;   C-f    Move right inserting spaces if required.
  665.   ;;   C-b    Move left changing tabs to spaces if required.
  666.   ;;   C-c C-f    Move in direction of current picture motion.
  667.   ;;   C-c C-b    Move in opposite direction of current picture motion.
  668.   ;;   Return    Move to beginning of next line.
  669.   ;; You can edit tabular text with these commands:
  670.   ;;   M-Tab    Move to column beneath (or at) next interesting character.
  671.   ;;        `Indents' relative to a previous line.
  672.   ;;   Tab    Move to next stop in tab stop list.
  673.   ;;   C-c Tab    Set tab stops according to context of this line.
  674.   ;;         With ARG resets tab stops to default (global) value.
  675.   ;;         See also documentation of variable    picture-tab-chars
  676.   ;;         which defines "interesting character".  You can manually
  677.   ;;         change the tab stop list with command [edit-tab-stops].
  678.   ;; You can manipulate text with these commands:
  679.   ;;   C-d      Clear (replace) ARG columns after point without moving.
  680.   ;;   C-c C-d    Delete char at point - the command normally assigned to C-d.
  681.   ;;   Delete    Clear (replace) ARG columns before point, moving back over them.
  682.   ;;   C-k    Clear ARG lines, advancing over them.     The cleared
  683.   ;;         text is saved in the kill ring.
  684.   ;;   C-o    Open blank line(s) beneath current line.
  685.   ;; You can manipulate rectangles with these commands:
  686.   ;;   C-c C-k    Clear (or kill) a rectangle and save it.
  687.   ;;   C-c C-w    Like C-c C-k except rectangle is saved in named register.
  688.   ;;   C-c C-y    Overlay (or insert) currently saved rectangle at point.
  689.   ;;   C-c C-x    Like C-c C-y except rectangle is taken from named register.
  690.   ;; You can return to the previous mode with:
  691.   ;;   C-c C-c    Which also strips trailing whitespace from every line.
  692.   ;;         Stripping is suppressed by supplying an argument.
  693.  
  694.   ;; Note that Picture mode commands will work outside of Picture mode, but
  695.   ;; they are not defaultly assigned to keys.
  696.  
  697. (defun edit-picture
  698. {
  699. ;  (if (eq major-mode 'edit-picture)
  700. ;      (error "You are already editing a Picture.")
  701.   (picture-set-motion 0 1)
  702.   (picture-tab-chars default-pic-tab-chars)
  703.   (num-pic-tabs 0)
  704.   (pic-keymap)
  705.   (msg "Picture mode")
  706. })
  707.  
  708.   ;; Undo edit-picture and return to previous major mode.
  709.   ;; With no argument strips whitespace from end of every line in Picture
  710.   ;;   buffer otherwise just return to previous mode.
  711. (defun picture-mode-exit
  712. ;  (if (not (eq major-mode 'edit-picture))
  713. ;      (error "You aren't editing a Picture.")
  714. ;    (if (not nostrip) (picture-clean))
  715. {
  716.   (pic-unkeymap)
  717.   (remove-trailing-whitespace)
  718.   (msg "Picture done")
  719. })
  720.